home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue34 / alfresco / TrieTest.dpr < prev   
Encoding:
Text File  |  1998-04-22  |  4.2 KB  |  155 lines
  1. program TrieTest;
  2.  
  3. {$IFDEF VER80}
  4. !! Error
  5. This program is for long strings only. In other words, you must be
  6. using Delphi 2 or later. The reason is that the trie assumes that the
  7. string is terminated by a null.
  8. {$ENDIF}
  9.  
  10. {$APPTYPE CONSOLE}
  11.  
  12. uses
  13.   Windows,
  14.   SysUtils,
  15.   Classes,
  16.   Trie in 'trie.pas',
  17.   Ternary in 'Ternary.pas';
  18.  
  19.  
  20. {===Stream:get next word=============================================}
  21. function GetNextWord(Strm : TStream) : string;
  22. var
  23.   Ch : char;
  24. begin
  25.   Result := '';
  26.   with Strm do begin
  27.     Read(Ch, 1);
  28.     while not (Ch in [#0, 'a'..'z', 'A'..'Z', '0'..'9']) do
  29.       Read(Ch, 1);
  30.     while Ch in ['a'..'z', 'A'..'Z', '0'..'9'] do begin
  31.       Result := Result + Ch;
  32.       Read(Ch, 1);
  33.     end;
  34.   end;
  35. end;
  36. {====================================================================}
  37.  
  38. procedure WritelnAction(const S : string; Data : pointer);
  39. begin
  40.   writeln(S);
  41. end;
  42. procedure WriteAction(const S : string; Data : pointer);
  43. begin
  44.   write(S, ' ');
  45. end;
  46.  
  47.  
  48. var
  49.   MyTrie     : TTrie;
  50.   TernTree   : TTernaryTree;
  51.   StringList : TStringList;
  52.   Obj  : pointer;
  53.   Strm : TMemoryStream;
  54.   Ch   : char;
  55.   NextWord : string;
  56.   StartTime, EndTime : integer;
  57.   TotalSize : integer;
  58.   Count     : integer;
  59. begin
  60.   Strm := TMemoryStream.Create;
  61.   try
  62.     Strm.LoadFromFile('HENRYV.TXT');
  63.     Strm.Position := Strm.Size;
  64.     Ch := #0;
  65.     Strm.Write(Ch, 1);
  66.     Strm.Position := 0;
  67.     StringList := TStringList.Create;
  68.     try
  69.       StringList.Sorted := true;
  70.       NextWord := GetNextWord(Strm);
  71.       while (NextWord <> '') do begin
  72.         StringList.AddObject(NextWord, @MyTrie);
  73.         NextWord := GetNextWord(Strm);
  74.       end;
  75.       StartTime := GetTickCount;
  76.       for Count := 1 to 300 do begin
  77.         Strm.Position := 0;
  78.         NextWord := GetNextWord(Strm);
  79.         while (NextWord <> '') do begin
  80.           if (StringList.IndexOf(NextWord) = -1) then
  81.             writeln('Error, didn''t find [', NextWord, ']');
  82.           NextWord := GetNextWord(Strm);
  83.         end;
  84.       end;
  85.       EndTime := GetTickCount;
  86.     finally
  87.       StringList.Free;
  88.     end;
  89.     writeln('StringList time: ', EndTime-StartTime);
  90.  
  91.     Strm.Position := 0;
  92.     MyTrie := TTrie.Create;
  93.     try
  94.       NextWord := GetNextWord(Strm);
  95.       while (NextWord <> '') do begin
  96.         MyTrie.AddObject(NextWord, @MyTrie);
  97.         NextWord := GetNextWord(Strm);
  98.       end;
  99.       StartTime := GetTickCount;
  100.       for Count := 1 to 300 do begin
  101.         Strm.Position := 0;
  102.         NextWord := GetNextWord(Strm);
  103.         while (NextWord <> '') do begin
  104.           if not MyTrie.FindString(NextWord, Obj) then
  105.             writeln('Error, didn''t find [', NextWord, ']');
  106.           NextWord := GetNextWord(Strm);
  107.         end;
  108.       end;
  109.       EndTime := GetTickCount;
  110.       TotalSize := MyTrie.NodeCount * sizeof(TTrieNode);
  111.     finally
  112.       MyTrie.Free;
  113.     end;
  114.     writeln('Trie time: ', EndTime-StartTime);
  115.     writeln('Trie size: ', TotalSize);
  116.  
  117.     Strm.Position := 0;
  118.     TernTree := TTernaryTree.Create;
  119.     try
  120.       TernTree.IgnoreCase := true;
  121.       NextWord := GetNextWord(Strm);
  122.       while (NextWord <> '') do begin
  123.         if not TernTree.Search(NextWord, Obj) then
  124.           TernTree.Insert(NextWord, @MyTrie);
  125.         NextWord := GetNextWord(Strm);
  126.       end;
  127.       StartTime := GetTickCount;
  128.       for Count := 1 to 300 do begin
  129.         Strm.Position := 0;
  130.         NextWord := GetNextWord(Strm);
  131.         while (NextWord <> '') do begin
  132.           if not TernTree.Search(NextWord, Obj) then
  133.             writeln('Error, didn''t find [', NextWord, ']');
  134.           NextWord := GetNextWord(Strm);
  135.         end;
  136.       end;
  137.       EndTime := GetTickCount;
  138.       TernTree.Iterate(WriteAction);                writeln;
  139.       TernTree.PartialSearch('....e', WriteAction); writeln;
  140.       TernTree.PartialSearch('...e.', WriteAction); writeln;
  141.       TernTree.PartialSearch('..e..', WriteAction); writeln;
  142.       TernTree.PartialSearch('.e...', WriteAction); writeln;
  143.       TernTree.PartialSearch('e....', WriteAction); writeln;
  144.     finally
  145.       TernTree.Free;
  146.     end;
  147.     writeln('ternary Tree time: ', EndTime-StartTime);
  148.  
  149.   finally
  150.     Strm.Free;
  151.   end;
  152.   readln;
  153. end.
  154.  
  155.